module filterMod

#include "shr_assert.h"

  !-----------------------------------------------------------------------
  ! !DESCRIPTION:
  ! Module of filters used for processing columns and patches of particular
  ! types, including lake, non-lake, urban, soil, snow, non-snow, and
  ! naturally-vegetated patches.
  !
  ! !USES:
  use shr_kind_mod   , only : r8 => shr_kind_r8
  use shr_log_mod    , only : errMsg => shr_log_errMsg
  use abortutils     , only : endrun
  use clm_varctl     , only : iulog
  use decompMod      , only : bounds_type
  use GridcellType   , only : grc
  use LandunitType   , only : lun
  use ColumnType     , only : col
  use PatchType      , only : patch
  use glcBehaviorMod , only : glc_behavior_type
  !
  ! !PUBLIC TYPES:
  implicit none
  save
  private
  !
  type clumpfilter
     integer, pointer :: allc(:)         ! all columns
     integer :: num_allc                 ! number of points in allc filter

     integer, pointer :: natvegp(:)      ! CNDV nat-vegetated (present) filter (patches)
     integer :: num_natvegp              ! number of patches in nat-vegetated filter

     integer, pointer :: pcropp(:)       ! prognostic crop filter (patches)
     integer :: num_pcropp               ! number of patches in prognostic crop filter
     integer, pointer :: soilnopcropp(:) ! soil w/o prog. crops (patches)
     integer :: num_soilnopcropp         ! number of patches in soil w/o prog crops

     integer, pointer :: all_soil_patches(:) ! all soil or crop patches. Used for updating FATES SP drivers
     integer :: num_all_soil_patches         ! number of patches in all_soil_patches filter

     integer, pointer :: lakep(:)        ! lake filter (patches)
     integer :: num_lakep                ! number of patches in lake filter
     integer, pointer :: nolakep(:)      ! non-lake filter (patches)
     integer :: num_nolakep              ! number of patches in non-lake filter
     integer, pointer :: lakec(:)        ! lake filter (columns)
     integer :: num_lakec                ! number of columns in lake filter
     integer, pointer :: nolakec(:)      ! non-lake filter (columns)
     integer :: num_nolakec              ! number of columns in non-lake filter

     integer, pointer :: soilc(:)        ! soil filter (columns)
     integer :: num_soilc                ! number of columns in soil filter
     integer, pointer :: soilp(:)        ! soil filter (patches)
     integer :: num_soilp                ! number of patches in soil filter

     integer, pointer :: snowc(:)        ! snow filter (columns)
     integer :: num_snowc                ! number of columns in snow filter
     integer, pointer :: nosnowc(:)      ! non-snow filter (columns)
     integer :: num_nosnowc              ! number of columns in non-snow filter

     integer, pointer :: lakesnowc(:)    ! snow filter (columns)
     integer :: num_lakesnowc            ! number of columns in snow filter
     integer, pointer :: lakenosnowc(:)  ! non-snow filter (columns)
     integer :: num_lakenosnowc          ! number of columns in non-snow filter

     integer, pointer :: exposedvegp(:)  ! patches where frac_veg_nosno is non-zero
     integer :: num_exposedvegp          ! number of patches in exposedvegp filter
     integer, pointer :: noexposedvegp(:)! patches where frac_veg_nosno is 0 (does NOT include lake or urban)
     integer :: num_noexposedvegp        ! number of patches in noexposedvegp filter

     integer, pointer :: hydrologyc(:)   ! hydrology filter (columns)
     integer :: num_hydrologyc           ! number of columns in hydrology filter

     integer, pointer :: urbanl(:)       ! urban filter (landunits)
     integer :: num_urbanl               ! number of landunits in urban filter
     integer, pointer :: nourbanl(:)     ! non-urban filter (landunits)
     integer :: num_nourbanl             ! number of landunits in non-urban filter

     integer, pointer :: urbanc(:)       ! urban filter (columns)
     integer :: num_urbanc               ! number of columns in urban filter
     integer, pointer :: nourbanc(:)     ! non-urban filter (columns)
     integer :: num_nourbanc             ! number of columns in non-urban filter

     integer, pointer :: urbanp(:)       ! urban filter (patches)
     integer :: num_urbanp               ! number of patches in urban filter
     integer, pointer :: nourbanp(:)     ! non-urban filter (patches)
     integer :: num_nourbanp             ! number of patches in non-urban filter

     integer, pointer :: nolakeurbanp(:) ! non-lake, non-urban filter (patches)
     integer :: num_nolakeurbanp         ! number of patches in non-lake, non-urban filter

     integer, pointer :: icec(:)         ! glacier filter (cols)
     integer :: num_icec                 ! number of columns in glacier filter

     integer, pointer :: do_smb_c(:)     ! glacier+bareland SMB calculations-on filter (cols)
     integer :: num_do_smb_c             ! number of columns in glacier+bareland SMB mec filter

     integer, pointer :: actfirec(:)     ! soil columns with active fire filter (cols)
     integer :: num_actfirec             ! number of columns in active fire filter

     integer, pointer :: actfirep(:)     ! soil patches with active fire filter (patches)
     integer :: num_actfirep             ! number of patches in active fire filter

  end type clumpfilter
  public clumpfilter

  ! This is the standard set of filters, which should be used in most places in the code.
  ! These filters only include 'active' points.
  type(clumpfilter), allocatable, public :: filter(:)

  ! --- DO NOT USING THE FOLLOWING VARIABLE UNLESS YOU KNOW WHAT YOU'RE DOING! ---
  !
  ! This is a separate set of filters that contains both inactive and active points. It is
  ! rarely appropriate to use these, but they are needed in a few places, e.g., where
  ! quantities are computed before weights, active flags and filters are updated due to
  ! landuse change. Note that, for the handful of filters that are computed outside of
  ! setFiltersOneGroup (including the CNDV natvegp filter and the snow filters), these
  ! filters are NOT included in this variable - so they can only be used from the main
  ! 'filter' variable.
  !
  ! Ideally, we would like to restructure the initialization code and driver ordering so
  ! that this version of the filters is never needed. At that point, we could remove this
  ! filter_inactive_and_active variable, and simplify filterMod to look the way it did
  ! before this variable was added (i.e., when there was only a single group of filters).
  !
  type(clumpfilter), allocatable, public :: filter_inactive_and_active(:)
  !
  public allocFilters         ! allocate memory for filters
  public setFilters           ! set filters
  public setExposedvegpFilter ! set the exposedvegp and noexposedvegp filters

  private allocFiltersOneGroup  ! allocate memory for one group of filters
  private setFiltersOneGroup    ! set one group of filters

  character(len=*), parameter, private :: sourcefile = &
       __FILE__
  !
  ! !REVISION HISTORY:
  ! Created by Mariana Vertenstein
  ! 11/13/03, Peter Thornton: Added soilp and num_soilp
  ! Jan/08, S. Levis: Added crop-related filters
  ! June/13, Bill Sacks: Change main filters to just work over 'active' points;
  ! add filter_inactive_and_active
  !-----------------------------------------------------------------------

contains

  !------------------------------------------------------------------------
  subroutine allocFilters()
    !
    ! !DESCRIPTION:
    ! Allocate CLM filters.
    !
    ! !REVISION HISTORY:
    ! Created by Bill Sacks
    !------------------------------------------------------------------------

    call allocFiltersOneGroup(filter)
    call allocFiltersOneGroup(filter_inactive_and_active)

  end subroutine allocFilters

  !------------------------------------------------------------------------
  subroutine allocFiltersOneGroup(this_filter)
    !
    ! !DESCRIPTION:
    ! Allocate CLM filters, for one group of filters.
    !
    ! !USES:
    use decompMod , only : get_proc_clumps, get_clump_bounds
    !
    ! !ARGUMENTS:
    type(clumpfilter), intent(inout), allocatable :: this_filter(:)  ! the filter to allocate
    !
    ! LOCAL VARAIBLES:
    integer :: nc          ! clump index
    integer :: nclumps     ! total number of clumps on this processor
    integer :: ier         ! error status
    type(bounds_type) :: bounds
    !------------------------------------------------------------------------

    ! Determine clump variables for this processor

    nclumps = get_proc_clumps()

    ier = 0
    if( .not. allocated(this_filter)) then
       allocate(this_filter(nclumps), stat=ier)
    end if
    if (ier /= 0) then
       write(iulog,*) 'allocFiltersOneGroup(): allocation error for clumpsfilters'
       call endrun(msg=errMsg(sourcefile, __LINE__))
    end if

    ! Loop over clumps on this processor

!$OMP PARALLEL DO PRIVATE (nc,bounds)
    do nc = 1, nclumps
       call get_clump_bounds(nc, bounds)

       allocate(this_filter(nc)%allc(bounds%endc-bounds%begc+1))

       allocate(this_filter(nc)%lakep(bounds%endp-bounds%begp+1))
       allocate(this_filter(nc)%nolakep(bounds%endp-bounds%begp+1))
       allocate(this_filter(nc)%nolakeurbanp(bounds%endp-bounds%begp+1))

       allocate(this_filter(nc)%lakec(bounds%endc-bounds%begc+1))
       allocate(this_filter(nc)%nolakec(bounds%endc-bounds%begc+1))

       allocate(this_filter(nc)%soilc(bounds%endc-bounds%begc+1))
       allocate(this_filter(nc)%soilp(bounds%endp-bounds%begp+1))

       allocate(this_filter(nc)%snowc(bounds%endc-bounds%begc+1))
       allocate(this_filter(nc)%nosnowc(bounds%endc-bounds%begc+1))

       allocate(this_filter(nc)%lakesnowc(bounds%endc-bounds%begc+1))
       allocate(this_filter(nc)%lakenosnowc(bounds%endc-bounds%begc+1))

       allocate(this_filter(nc)%exposedvegp(bounds%endp-bounds%begp+1))
       allocate(this_filter(nc)%noexposedvegp(bounds%endp-bounds%begp+1))

       allocate(this_filter(nc)%natvegp(bounds%endp-bounds%begp+1))

       allocate(this_filter(nc)%hydrologyc(bounds%endc-bounds%begc+1))

       allocate(this_filter(nc)%urbanp(bounds%endp-bounds%begp+1))
       allocate(this_filter(nc)%nourbanp(bounds%endp-bounds%begp+1))

       allocate(this_filter(nc)%urbanc(bounds%endc-bounds%begc+1))
       allocate(this_filter(nc)%nourbanc(bounds%endc-bounds%begc+1))

       allocate(this_filter(nc)%urbanl(bounds%endl-bounds%begl+1))
       allocate(this_filter(nc)%nourbanl(bounds%endl-bounds%begl+1))

       allocate(this_filter(nc)%pcropp(bounds%endp-bounds%begp+1))
       allocate(this_filter(nc)%soilnopcropp(bounds%endp-bounds%begp+1))

       allocate(this_filter(nc)%icec(bounds%endc-bounds%begc+1))
       allocate(this_filter(nc)%do_smb_c(bounds%endc-bounds%begc+1))

       allocate(this_filter(nc)%actfirec(bounds%endc-bounds%begc+1))
       allocate(this_filter(nc)%actfirep(bounds%endp-bounds%begp+1))

       this_filter(nc)%num_actfirep = 1
       this_filter(nc)%num_actfirec = 1
       
    end do
!$OMP END PARALLEL DO

  end subroutine allocFiltersOneGroup

  !------------------------------------------------------------------------
  subroutine setFilters(bounds, glc_behavior)
    !
    ! !DESCRIPTION:
    ! Set CLM filters.
    use decompMod , only : bounds_level_clump
    !
    ! !ARGUMENTS:
    type(bounds_type)       , intent(in) :: bounds
    type(glc_behavior_type) , intent(in) :: glc_behavior
    !------------------------------------------------------------------------

    SHR_ASSERT_FL(bounds%level == bounds_level_clump, sourcefile, __LINE__)

    call setFiltersOneGroup(bounds, &
         filter, include_inactive = .false., &
         glc_behavior = glc_behavior)

    ! At least as of June, 2013, the 'inactive_and_active' version of the filters is
    ! static in time. Thus, we could have some logic saying whether we're in
    ! initialization, and if so, skip this call. But this is problematic for two reasons:
    ! (1) it requires that the caller of this routine (currently reweight_wrapup) know
    ! whether it is in initialization; and (2) it assumes that the filter definitions
    ! won't be changed in the future in a way that creates some variability in time. So
    ! for now, it seems cleanest and safest to just update these filters whenever the main
    ! filters are updated. But if this proves to be a performance problem, we could
    ! introduce an argument saying whether we're in initialization, and if so, skip this
    ! call.

    call setFiltersOneGroup(bounds, &
         filter_inactive_and_active, include_inactive = .true., &
         glc_behavior = glc_behavior)

  end subroutine setFilters


  !------------------------------------------------------------------------
  subroutine setFiltersOneGroup(bounds, this_filter, include_inactive, glc_behavior)
    !
    ! !DESCRIPTION:
    ! Set CLM filters for one group of filters.
    !
    ! "Standard" filters only include active points. However, this routine can be used to set
    ! alternative filters that also apply over inactive points, by setting include_inactive =
    ! .true.
    !
    ! This routine sets filters that are determined by subgrid type, "active" status of
    ! patch, col or landunit, and the like. Filters based on model state (e.g., snow
    ! cover) should generally be set elsewhere, to ensure that the routine that sets them
    ! is called at the right time in the driver loop.
    !
    ! !USES:
    use decompMod       , only : bounds_level_clump
    use pftconMod       , only : npcropmin
    use landunit_varcon , only : istsoil, istcrop, istice
    !
    ! !ARGUMENTS:
    type(bounds_type)       , intent(in)    :: bounds
    type(clumpfilter)       , intent(inout) :: this_filter(:)   ! the group of filters to set
    logical                 , intent(in)    :: include_inactive ! whether inactive points should be included in the filters
    type(glc_behavior_type) , intent(in)    :: glc_behavior
    !
    ! LOCAL VARAIBLES:
    integer :: nc          ! clump index
    integer :: c,l,p       ! column, landunit, patch indices
    integer :: fl          ! lake filter index
    integer :: fnl,fnlu    ! non-lake filter index
    integer :: fs          ! soil filter index
    integer :: f, fn       ! general indices
    integer :: g           !gridcell index
    !------------------------------------------------------------------------

    SHR_ASSERT_FL(bounds%level == bounds_level_clump, sourcefile, __LINE__)

    nc = bounds%clump_index

    ! Create filter of all columns
    fl = 0
    do c = bounds%begc,bounds%endc
       if (col%active(c) .or. include_inactive) then
          fl = fl + 1
          this_filter(nc)%allc(fl) = c
       end if
    end do
    this_filter(nc)%num_allc = fl

    ! Create lake and non-lake filters at column-level

    fl = 0
    fnl = 0
    do c = bounds%begc,bounds%endc
       if (col%active(c) .or. include_inactive) then
          l =col%landunit(c)
          if (lun%lakpoi(l)) then
             fl = fl + 1
             this_filter(nc)%lakec(fl) = c
          else
             fnl = fnl + 1
             this_filter(nc)%nolakec(fnl) = c
          end if
       end if
    end do
    this_filter(nc)%num_lakec = fl
    this_filter(nc)%num_nolakec = fnl

    ! Create lake and non-lake filters at patch-level

    fl = 0
    fnl = 0
    fnlu = 0
    do p = bounds%begp,bounds%endp
       if (patch%active(p) .or. include_inactive) then
          l =patch%landunit(p)
          if (lun%lakpoi(l) ) then
             fl = fl + 1
             this_filter(nc)%lakep(fl) = p
          else
             fnl = fnl + 1
             this_filter(nc)%nolakep(fnl) = p
             if (.not. lun%urbpoi(l)) then
                fnlu = fnlu + 1
                this_filter(nc)%nolakeurbanp(fnlu) = p
             end if
          end if
       end if
    end do
    this_filter(nc)%num_lakep = fl
    this_filter(nc)%num_nolakep = fnl
    this_filter(nc)%num_nolakeurbanp = fnlu

    ! Create soil filter at column-level

    fs = 0
    do c = bounds%begc,bounds%endc
       if (col%active(c) .or. include_inactive) then
          l =col%landunit(c)
          if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
             fs = fs + 1
             this_filter(nc)%soilc(fs) = c
          end if
       end if
    end do
    this_filter(nc)%num_soilc = fs
    ! Create soil filter at patch-level

    fs = 0
    do p = bounds%begp,bounds%endp
       if (patch%active(p) .or. include_inactive) then
          l =patch%landunit(p)
          if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
             fs = fs + 1
             this_filter(nc)%soilp(fs) = p
          end if
       end if
    end do
    this_filter(nc)%num_soilp = fs

    ! Create column-level hydrology filter (soil and Urban pervious road cols)

    f = 0
    do c = bounds%begc,bounds%endc
       if (col%active(c) .or. include_inactive) then
          if (col%hydrologically_active(c)) then
             f = f + 1
             this_filter(nc)%hydrologyc(f) = c
          end if
       end if
    end do
    this_filter(nc)%num_hydrologyc = f

    ! Create prognostic crop and soil w/o prog. crop filters at patch-level
    ! according to where the crop model should be used

    fl  = 0
    fnl = 0
    do p = bounds%begp,bounds%endp
       if (patch%active(p) .or. include_inactive) then
          if (patch%itype(p) >= npcropmin) then !skips 2 generic crop types
             fl = fl + 1
             this_filter(nc)%pcropp(fl) = p
          else
             l =patch%landunit(p)
             if (lun%itype(l) == istsoil .or. lun%itype(l) == istcrop) then
                fnl = fnl + 1
                this_filter(nc)%soilnopcropp(fnl) = p
             end if
          end if
       end if
    end do
    this_filter(nc)%num_pcropp   = fl
    this_filter(nc)%num_soilnopcropp = fnl   ! This wasn't being set before...

    ! Create landunit-level urban and non-urban filters

    f = 0
    fn = 0
    do l = bounds%begl,bounds%endl
       if (lun%active(l) .or. include_inactive) then
          if (lun%urbpoi(l)) then
             f = f + 1
             this_filter(nc)%urbanl(f) = l
          else
             fn = fn + 1
             this_filter(nc)%nourbanl(fn) = l
          end if
       end if
    end do
    this_filter(nc)%num_urbanl = f
    this_filter(nc)%num_nourbanl = fn

    ! Create column-level urban and non-urban filters

    f = 0
    fn = 0
    do c = bounds%begc,bounds%endc
       if (col%active(c) .or. include_inactive) then
          l = col%landunit(c)
          if (lun%urbpoi(l)) then
             f = f + 1
             this_filter(nc)%urbanc(f) = c
          else
             fn = fn + 1
             this_filter(nc)%nourbanc(fn) = c
          end if
       end if
    end do
    this_filter(nc)%num_urbanc = f
    this_filter(nc)%num_nourbanc = fn

    ! Create patch-level urban and non-urban filters

    f = 0
    fn = 0
    do p = bounds%begp,bounds%endp
       if (patch%active(p) .or. include_inactive) then
          l = patch%landunit(p)
          if (lun%urbpoi(l)) then
             f = f + 1
             this_filter(nc)%urbanp(f) = p
          else
             fn = fn + 1
             this_filter(nc)%nourbanp(fn) = p
          end if
       end if
    end do
    this_filter(nc)%num_urbanp = f
    this_filter(nc)%num_nourbanp = fn

    f = 0
    do c = bounds%begc,bounds%endc
       if (col%active(c) .or. include_inactive) then
          l = col%landunit(c)
          if (lun%itype(l) == istice) then
             f = f + 1
             this_filter(nc)%icec(f) = c
          end if
       end if
    end do
    this_filter(nc)%num_icec = f

    f = 0
    do c = bounds%begc,bounds%endc
       if (col%active(c) .or. include_inactive) then
          l = col%landunit(c)
          g = col%gridcell(c)

          ! Only compute SMB in regions where we replace ice melt with new ice:
          ! Elsewhere (where ice melt remains in place), we cannot compute a sensible
          ! negative SMB.
          !
          ! In addition to istice columns, we also compute SMB for any soil column in
          ! this region, in order to provide SMB forcing for the bare ground elevation
          ! class (elevation class 0).
          if ( glc_behavior%melt_replaced_by_ice_grc(g) .and. &
               (lun%itype(l) == istice .or. lun%itype(l) == istsoil)) then
             f = f + 1
             this_filter(nc)%do_smb_c(f) = c
          end if
       end if
    end do
    this_filter(nc)%num_do_smb_c = f

    ! Note: snow filters are reconstructed each time step in
    ! LakeHydrology and SnowHydrology
    ! Note: CNDV "pft present" filter is reconstructed each time CNDV is run

  end subroutine setFiltersOneGroup

  !-----------------------------------------------------------------------
  subroutine setExposedvegpFilter(bounds, frac_veg_nosno)
    !
    ! !DESCRIPTION:
    ! Sets the exposedvegp and noexposedvegp filters for one clump.
    !
    ! The exposedvegp filter includes points for which frac_veg_nosno > 0. noexposedvegp
    ! includes points for which frac_veg_nosno <= 0. However, note that neither filter
    ! includes urban or lake points!
    !
    ! Should be called from within a loop over clumps.
    !
    ! Only sets this filter in the main 'filter' variable, NOT in
    ! filter_inactive_and_active.
    !
    ! Note that this is done separately from the main setFilters routine, because it may
    ! need to be called at a different time in the driver loop.
    !
    ! !USES:
    use decompMod , only : bounds_level_clump
    !
    ! !ARGUMENTS:
    type(bounds_type) , intent(in) :: bounds
    integer           , intent(in) :: frac_veg_nosno( bounds%begp: ) ! fraction of vegetation not covered by snow [patch]
    !
    ! !LOCAL VARIABLES:
    integer :: nc     ! clump index
    integer :: fp     ! filter index
    integer :: p      ! patch index
    integer :: fe, fn ! filter counts

    character(len=*), parameter :: subname = 'setExposedvegpFilter'
    !-----------------------------------------------------------------------

    SHR_ASSERT_FL(bounds%level == bounds_level_clump, sourcefile, __LINE__)
    SHR_ASSERT_ALL_FL((ubound(frac_veg_nosno) == (/bounds%endp/)), sourcefile, __LINE__)

    nc = bounds%clump_index

    fe = 0
    fn = 0
    do fp = 1, filter(nc)%num_nolakeurbanp
       p = filter(nc)%nolakeurbanp(fp)
       if (frac_veg_nosno(p) > 0) then
          fe = fe + 1
          filter(nc)%exposedvegp(fe) = p
       else
          fn = fn + 1
          filter(nc)%noexposedvegp(fn) = p
       end if
    end do
    filter(nc)%num_exposedvegp = fe
    filter(nc)%num_noexposedvegp = fn

  end subroutine setExposedvegpFilter


end module filterMod
